Attribute VB_Name = "modGeneral"
Option Explicit
'for extract:
'BARB: MUST DO FILE VALIDATION
'REC COUNT <= 1000

'\\bxw2105_01 - Sql Server

Public objReg As clsRegistry
Public objAdoConn As Object
Public objFileFunctions As clsFileFunctions

'ERROR CONSTANTS
'If data is extracted to a file correctly, the no of records extracted is returned
Public Const NO_DATA_TO_INSERT As Long = 0
Public Const DATABASE_CONNECTION_FAILED As Long = -1
Public Const FILE_ERROR As Long = -2
Public Const ERR_IN_FILE_SEQ_NO As Long = -3
Public Const ERROR_CREATING_HEADER_RECORD As Long = -4
Public Const ERROR_IN_FOOTER_AGGREGATES As Long = -5
Public Const ERROR_READING_RECORDS As Long = -6
Public Const ERROR_FORMATING_RECORDS As Long = -7
Public Const ERROR_INSERTING_RECORD As Long = -8
Public Const FILE_CLEAN_UP_ERROR As Long = -9
Public Const UNKNOWN_ERROR_OCCURRED As Long = -10
Public Const RESPONSE_FILE_LOCATION_UNKNOWN As Long = -11
'
''Local error values
'Private Type ErrorDetailsProperties
'   strErrorStringDesc As String
'   colExtractFileLineNo As Collection
'   intExtractFileNo As Long
'   lngErrorCount As Long
'End Type
'Private ErrorDetails As ErrorDetailsProperties

Public HeaderFileFlag As Boolean

Public lngErrorCount As Long
Public strErrorString As String

Public Const SQL_DB As String = "SQLOLEDB.1"
Public Const ORA_DB As String = "MSDAORA.1"

'Registry Function Prototypes
Declare Function RegOpenKeyEx Lib "advapi32" _
  Alias "RegOpenKeyExA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  ByVal ulOptions As Long, _
  ByVal samDesired As Long, _
  phkResult As Long _
) As Long

Declare Function RegQueryValueEx Lib "advapi32" _
  Alias "RegQueryValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal lpReserved As Long, _
  ByRef lpType As Long, _
  ByVal szData As String, _
  ByRef lpcbData As Long _
) As Long

Declare Function RegCloseKey Lib "advapi32" ( _
  ByVal hKey As Long _
) As Long

Type TSECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End Type


Declare Function RegCreateKeyEx Lib "advapi32" _
  Alias "RegCreateKeyExA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  ByVal Reserved As Long, _
  ByVal lpClass As String, _
  ByVal dwOptions As Long, _
  ByVal samDesired As Long, _
  lpSecurityAttributes As TSECURITY_ATTRIBUTES, _
  phkResult As Long, _
  lpdwDisposition As Long _
) As Long



Declare Function RegSetValueEx Lib "advapi32" _
  Alias "RegSetValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal Reserved As Long, _
  ByVal dwType As Long, _
  ByVal szData As String, _
  ByVal cbData As Long _
) As Long

Public Sub TokenizeString(strSearch As String, strSeparator As String, daResult() As Variant)
    Dim Pos As Integer
    Dim strNew As String
    Dim iArrayCounter As Integer

    iArrayCounter = 0
    strNew = strSearch
    Pos = InStr(1, strSearch, strSeparator)
    Do While Pos <> 0
        ReDim Preserve daResult(iArrayCounter)
        daResult(iArrayCounter) = Left(strNew, Pos - 1)
        strNew = Right(strNew, Len(strNew) - Pos)
        iArrayCounter = iArrayCounter + 1
        Pos = InStr(1, strNew, strSeparator)
    Loop
        ReDim Preserve daResult(iArrayCounter)
        daResult(iArrayCounter) = strNew
    'TokenizeString = daResult
End Sub

Public Function Encrypt(ByVal strText As String, _
                        ByVal strCipher As String) As String
  Dim lngIndex As Long
  Dim strEncryptedText As String
  Dim lngCipherLength As Long
  Dim strTextArray() As String
  Dim lngHolder As Long
  Dim strTextHolder As String
  Dim strTextToLongHolder As String
  Dim i As Long


  'check to see if the text sent in is a bunch of numbers
  lngHolder = Val(strText)
  If lngHolder = 0 Then 'this is a string that does not need conversion from the character codes back to a string
    strTextHolder = strText
  Else 'this is a long that needs to be converted back to a string
    ReDim strTextArray(0)

    strTextArray = Split(strText, "~", -1)
    For i = 0 To UBound(strTextArray) - 1
        strTextHolder = strTextHolder & Chr(strTextArray(i))
    Next
  End If
  'both the return and the Text to encrypt need to be longs so
    'that they are not truncated when
  'they get saved or displayed

  'convert the Text to a long

  lngCipherLength = Len(strCipher)

  Do Until Len(strEncryptedText) = Len(strTextHolder)
    For lngIndex = 1 To lngCipherLength

      ' We are done when the two strings are equal in length
      If Len(strEncryptedText) = Len(strTextHolder) Then
        Exit For
      End If

      ' Perform the XOR encryption
      strEncryptedText = strEncryptedText & _
        Chr(Asc(Mid(strTextHolder, Len(strEncryptedText) + 1, 1)) Xor _
        Asc(Mid(strCipher, lngIndex, 1)))
    Next lngIndex
  Loop

  'check the the return value if its a decrypted string COOL

  If lngHolder <> 0 Then ' this is a decrypted string
    ' Return the encrypted/decrypted text
    Encrypt = strEncryptedText
  Else 'this is an encrypted string and needs to be converted to longs
    For i = 1 To Len(strEncryptedText)
        strTextToLongHolder = strTextToLongHolder & Asc(Mid$(strEncryptedText, i, 1)) & "~"
    Next
    'return the long'ed encrypted string
    Encrypt = strTextToLongHolder
  End If

End Function
Sub main()

'    Set objReg = New clsRegistry
'    Set objAdoConn = CreateObject("AdoDbserver.clsDbFunctions")
'    Set objFileFunctions = New clsFileFunctions
    

    frmTest.Show

End Sub
'Private Sub Shutdown()
'
'  Set objReg = Nothing
'  Set objAdoConn = Nothing
'  Set objFileFunctions = Nothing
'  Set objInsert = Nothing
'
'End Sub

Public Sub HandleError(strErrNumber As String, strErrDesc As String, strLocation As String, Optional strFreeText As String, Optional lngRecNo As Long)

    Dim FNum As Long
    Dim FName As String
    Dim strErrPathFile As String
    
    On Error GoTo HandleErrorFix

    'barb: here -eventually

    strErrPathFile = objReg.ErrorFileLocation & "\TkInsertCancelErrors" & Format(Date, "ddmmyyyy") & ".err"

'    If lngRecNo <> 0 Then
'        'Set ErrorDetails.colExtractFileLineNo.Count = ErrorDetails.colExtractFileLineNo.Count + 1
'
'        ErrorDetails.colExtractFileLineNo.Add lngRecNo
'        'errordetails.intExtractFileNo set this somewhere
'        strErrorString = Chr(13) & strErrorString & "Record number: " & lngRecNo
'    End If
    
    strErrorString = Chr(13) & _
        "Extracting from file: " & objReg.AsciiFileLocation & objReg.AsciiFileName & Chr(13) & _
        "Error: " & strErrorString & strErrNumber & " - " & strErrDesc & " occurred in " & strLocation & ". " & Chr(13) & _
        strFreeText & Chr(10) & ". While reading response file: " & objReg.AsciiFileLocation & objReg.AsciiFileName
        
    lngErrorCount = lngErrorCount + 1
    
    FNum = FreeFile
    FName = strErrPathFile
    
    Open FName For Append As FNum
    Write #FNum, strErrorString
    Close #FNum

    
    MsgBox strErrorString, vbCritical, "KeyTax Extract"
    'program must end here
    
    Exit Sub
HandleErrorFix:
    'IF THE SPECIFIED DIRECTORY DOESN'T EXIST CREATE IT, THEN OPEN/CREATE THE FILE
    If Err.Number = 76 Then
        MkDir strErrPathFile
        Open strErrPathFile For Append Access Write As #FNum
            Write #FNum, strErrorString
        Close #FNum
    Else
        MsgBox "WriteFile: " & Err.Number & " - " & Err.Description, vbExclamation, "Directory Clean Up"
        
    End If
    
    
End Sub

